﻿Imports HWInfo
'Imports gpuInfo.gpuInfo
Imports System.Runtime.InteropServices
Imports System.Text
Imports lspci

Module modMAIN
    Public DebugOutput As Boolean = False
    Public simpleNetworkbrowser As Boolean = False
    Public m_hwInfo As New HWInfo.clsHWInfo.cHWInfo
    Public logwindow As New clsLogwindow
    Public ClientConfig As New clsClientConfig
    Public ClientInfo As New clsClientInfo
    Public ProjectInfo As New clsProjectInfo
    Public Bussy As New clsBussy
    Public EOC As New clsEOCInfo
    Public mySettings As New clsSettings
    Public logParser As New clsClients
    Public sqdata As New Data
    Public sqlFilters As New clsFilters
    Public Statistics As New clsStatistics
    Public about As New clsAbout
    Public license As New clsLicense
    Public wuSnippet As New clsLSnippet
    Public zGraph As New clsZGRAPH
    Public pBrowser As New clsPBrowser
    Public lsPCI As New lspci.clsPci
    Public eLog As New clsEventLog
    Public Splash As New SplashScreen
    Public History As New frmHistory
    Public Tray As New TrayIcon
    Public Enum eSeverity
        Critical
        Important
        Informative
        Debug
    End Enum

    'TODO Notification form / Statistics ( grouping ) / Detailed History view with frame graph, statistics and core snippet 


    Public Function Init(Optional ByVal SplashForm As Form = Nothing) As Boolean
        WriteDebug("Application init started, splash=" & IsNothing(SplashForm))
        Dim rVal As Boolean = True   ' change back 
        If Not IsNothing(SplashForm) Then
            WriteDebug("Splash form being created")
            SplashForm.Show()
            SplashForm.TopMost = True
        End If
        Try
            If Not ClientConfig.Configuration.SetLocations() Then
                logwindow.WriteLog("Failed to find client folders, running verbose analysis.")
                ClientConfig.Configuration.SetLocations(True)
                rVal = False
                Exit Try
            Else
                logwindow.WriteLog("Found FAHClient folders!")
            End If
            'Fill info
            If ClientConfig.ReadFAHClientConfig Then
                logwindow.WriteLog("Client config obtained")
            Else
                logwindow.WriteLog("Could not obtain client config")
                rVal = False
                Exit Try
            End If
            Try
                clsClientInfo.FAHClientInfo.Parse()
                logwindow.WriteLog("Client info obtained")
            Catch ex As Exception
                logwindow.WriteLog("Could not obtain client info")
                rVal = False
                Exit Try
            End Try
            logwindow.WriteLog("Initializing database access")
            sqdata = New Data
            sqdata.Init(Application.StartupPath & "\")
            mySettings.Init()
            logwindow.WriteLog("Starting hardware detection")
            If Not m_hwInfo.Init() Then
                SplashForm.Close()
                Splash = Nothing
                'Check why?
                logwindow.WriteLog("*Hardware detection failed.")
            Else
                'Write a diagnostics to fahclient's shared data folder so other instanes have that information, include the port to use to communicate
                Dim strLD As New StringBuilder
                strLD.AppendLine("****** " & Application.ProductName & " " & My.Application.Info.Version.ToString & " diagnostics started ******")
                If My.Computer.FileSystem.FileExists(ClientConfig.Configuration.DataLocation & "\Diagnostics.txt") Then My.Computer.FileSystem.DeleteFile(ClientConfig.Configuration.DataLocation & "\Diagnostics.txt")
                If m_hwInfo.Territory.IsX64 Then
                    strLD.AppendLine("Os: " & m_hwInfo.Territory.OsName & " (x64)")
                Else
                    strLD.AppendLine("Os: " & m_hwInfo.Territory.OsName & " (x86)")
                End If
                strLD.AppendLine("Com port: " & mySettings.NetworkPort)
                Dim lString As String = Mid(m_hwInfo.ohmInterface.OHMReport, 1, m_hwInfo.ohmInterface.OHMReport.IndexOf("Sensors"))
                strLD.AppendLine(lString)
                If Not IsNothing(m_hwInfo.ohmInterface.ADL) Then
                    strLD.AppendLine(m_hwInfo.ohmInterface.ADL.Report)
                End If
                If Not IsNothing(m_hwInfo.ohmInterface.NVAPI) Then
                    strLD.AppendLine(m_hwInfo.ohmInterface.NVAPI.Report)
                End If
                If m_hwInfo.gpuInf.oclPlatform_count > 0 Then
                    strLD.AppendLine(m_hwInfo.gpuInf.openCLReport)
                End If
                If m_hwInfo.gpuInf.calDeviceCount > 0 Then
                    strLD.AppendLine(m_hwInfo.gpuInf.calReport)
                End If
                If m_hwInfo.gpuInf.CudaDeviceCount > 0 Then
                    strLD.AppendLine(m_hwInfo.gpuInf.cudaReport)
                End If
                WriteDebug("Diagnostics being saved to " & ClientConfig.Configuration.DataLocation)
                Try
                    My.Computer.FileSystem.WriteAllText(ClientConfig.Configuration.DataLocation & "\Diagnostics.txt", strLD.ToString, False)
                Catch ex As Exception
                    WriteError(ex.Message, Err)
                End Try
                strLD = Nothing
            End If
            'should be obsolete with the manifest change
            If Not m_hwInfo.Territory.IsAdmin Then
                logwindow.WriteLog("Application was started without admin rights and will now exit")
                MsgBox("This application needs admin rights!", CType(vbCritical + vbOKOnly, MsgBoxStyle))
                ExitApplication(True)
                End
            End If
            Dim bWarnThem As Boolean = False
            If mySettings.FirstRun Then
                logwindow.WriteLog("No settings stored, showing first run wizard.")
                bWarnThem = True
                Splash.Close()
                mySettings.ShowOptionsForm(Nothing)
            Else
                logwindow.WriteLog("Initializing parser for " & mySettings.LocalClientName)
                logParser.Init(mySettings.LocalClientName)
                logwindow.WriteLog("Checking for remote clients configuration.." & sqdata.HasRemoteClients.ToString)
                If sqdata.HasRemoteClients Then
                    If sqdata.ReadRemoteClients Then
                        logwindow.WriteLog("Remote clients initialized!")
                    Else
                        logwindow.WriteLog("Could not read the clients configuration!")
                    End If
                End If
            End If
            'Storing Diagnostics

            '... not implemented
            'Need projectinfo before parsing the logs right now ( should save credit based on psummary in db? might not be accurate )
            logwindow.WriteLog("Initializing project info")
            If sqdata.HasProjectInfo Then
                ProjectInfo.Projects = sqdata.ReadProjectInfo
                ProjectInfo.Name = "ProjectInfo"
            Else
                ProjectInfo.GetProjects("", True)
                ProjectInfo = sqdata.Update_ProjectInfo(ProjectInfo)
                logwindow.WriteLog("New project information downloaded")
            End If
            If bWarnThem Then
                MsgBox("This is the first time you're parsing your history so all of your log files will be checked and depending on the amount of clients and subsequent log files this might take some time.", CType(MsgBoxStyle.OkOnly + MsgBoxStyle.Information + MsgBoxStyle.MsgBoxSetForeground, MsgBoxStyle))
            End If
            Splash.Close()
            Dim dtStart As DateTime = DateTime.Now
            logwindow.WriteLog("Parsing logs started at " & dtStart.ToString)
            If logParser.ParseLogs(True, Nothing) Then
                Dim tsTmp As TimeSpan = DateTime.Now.Subtract(dtStart)
                logwindow.WriteLog("Logparser done, took " & FormatTimeSpan(tsTmp))
                tsTmp = Nothing
                dtStart = Nothing
            Else
                logwindow.WriteLog("Logparser failed!", eSeverity.Critical)
                Return False
            End If
            If clsStatistics.GenerateNewStatistics Then
                WriteLog("Generated statistics")
            Else
                WriteLog("Generating statistics failed", eSeverity.Critical)
            End If
            If sqdata.InitEOC Then
                WriteDebug("Initialized database for ExtremeOverclocking updates")
            Else
                WriteLog("Initializing database for ExtremeOverclocking updates failed", eSeverity.Critical)
            End If
            If EOC.Prepare Then
                WriteDebug("Initialized ExtremeOverclocking updates handler")
            Else
                WriteLog("Initializing ExtremeOverclocking updates handler failed", eSeverity.Critical)
            End If
            'Initialize filters
            If Not sqdata.InitSQLFilters Then
                WriteLog("Failed to get stored sql filters.", eSeverity.Important)
            Else
                WriteLog("Initialized sql filters")
            End If
            If Not mySettings.InitializeFilters Then
                WriteLog("Failed to get prepare notification filters.", eSeverity.Important)
            Else
                WriteLog("Initialized notification filters")
            End If
            If mySettings.FirstRun Then 'ChangeBack!
                If Not IsNothing(Splash) And Splash.Visible Then
                    Splash.Close()
                    Splash.Dispose()
                End If
                mySettings.ShowNotifyForm()
            End If
            If EOC.Init Then
                WriteLog("Initialized EOC xml updates")
            Else
                WriteLog("Failed to initialize EOC xml updates")
            End If
            If Not IsNothing(SplashForm) Then
                Splash.Close()
                Splash = Nothing
            End If
            'If mySettings.DefaultView = "historical" Then
            '    LogWindow.WriteLog("Showing History collection.")
            '    Application.Run(History)
            'Else
            '    Throw New NotImplementedException
            'End If
            rVal = True
        Catch ex As Exception
            logwindow.WriteError(ex.Message, Err)
            rVal = False
        End Try
        Return rVal
    End Function
    Public ReadOnly Property Diagnostic(Optional ByVal HidePassKey As Boolean = True, Optional ByVal Close As Boolean = False) As String
        Get
            If DebugOutput Then WriteDebug("Diagnostic property accessed")
            Static strDiag As String = ""
            If strDiag <> "" Then Return strDiag
            Dim sb As New StringBuilder
            Try
                If DebugOutput Then WriteDebug("Starting diagnostics")
                m_hwinfo.Init() ' Check if init is needed!!!
                sb.AppendLine("System diagnostic")
                If m_hwinfo.Territory.IsX64 Then
                    sb.AppendLine("Os: " & m_hwinfo.Territory.OsName & " (x64)")
                Else
                    sb.AppendLine("Os: " & m_hwinfo.Territory.OsName & " (x86)")
                End If
                Dim lString As String = Mid(m_hwinfo.ohmInterface.OHMReport, 1, m_hwinfo.ohmInterface.OHMReport.IndexOf("SMBIOS Table"))
                sb.AppendLine(lString)
                If Not IsNothing(m_hwinfo.ohmInterface.ADL) Then sb.Append(m_hwinfo.ohmInterface.ADL.Report)
                If Not IsNothing(m_hwinfo.ohmInterface.NVAPI) Then sb.Append(m_hwinfo.ohmInterface.NVAPI.Report)
                If m_hwinfo.gpuInf.oclPlatform_count > 0 Then sb.Append(m_hwinfo.gpuInf.openCLReport)
                If m_hwinfo.gpuInf.calDeviceCount > 0 Then sb.Append(m_hwinfo.gpuInf.calReport)
                If m_hwinfo.gpuInf.CudaDeviceCount > 0 Then sb.Append(m_hwinfo.gpuInf.cudaReport)
                sb.AppendLine("Reading client configuration: " & ClientConfig.ReadFAHClientConfig(False, True).ToString)
                If Not IsNothing(ClientConfig.Configuration) Then sb.AppendLine(ClientConfig.Configuration.Report(HidePassKey))
                sb.AppendLine("Running -lspci: " & lsPCI.FillInfo().ToString)
                sb.AppendLine(lsPCI.Report)
                clsClientInfo.FAHClientInfo.Parse()
                sb.AppendLine("Client info:")
                sb.AppendLine(ClientInfo.Info.Report)
                If Close Then
                    sb.Append("Query event log: ")
                    If eLog.QueryEventLog Then
                        sb.Append("succes" & Environment.NewLine)
                        sb.AppendLine(eLog.Report)
                    Else
                        sb.AppendLine("Failed to find any warning or error entries.")
                    End If
                End If
                sb.AppendLine("Closing diagnostics")
                If Close Then
                    If DebugOutput Then WriteDebug("Diagnosts finished, cleaning up")
                    m_hwinfo.ohmInterface.Close()
                    m_hwinfo.gpuInf = Nothing
                    m_hwinfo.ohmInterface = Nothing
                    m_hwInfo = Nothing
                Else
                    If DebugOutput Then WriteDebug("Diagnosts finished")
                End If
            Catch ex As Exception
                logwindow.WriteError(ex.Message, Err)
            End Try
            strDiag = sb.ToString
            Return sb.ToString
        End Get
    End Property
    'Replace Diagnostics code with call to diagnostic
    Public Sub Diagnostics()
        If DebugOutput Then WriteDebug("Starting Diagnostic")
        Splash.Show()
        Splash.ApplicationTitle.Text &= Environment.NewLine & "Diagnostics"
        Dim rVal As MsgBoxResult = MsgBox("Diagnostics output will contain your original Config.xml file, including your passkey. This can be helpfull, but brings the risk that you accidentally share your private passkey by posting the output on a forum. If you plan on posting the output to obtain help with a problem, the passkey can be checked on valid input and be hidden from the report." & Environment.NewLine & Environment.NewLine & "Do you want to hide the passkey in the report?", CType(vbQuestion & vbYesNo, MsgBoxStyle), "Hide your passkey?")
        Dim logDiag As New clsLogwindow
        Try
            If My.Computer.FileSystem.FileExists(Application.StartupPath & "\Diagnostics.txt") Then
                If DebugOutput Then WriteDebug("Deleting old Diagnostics.txt")
                My.Computer.FileSystem.DeleteFile(Application.StartupPath & "\Diagnostics.txt")
            End If
            logDiag.CreateLog(Application.StartupPath & "\Diagnostics.txt")
            'logdiag.ShowDebugWindow(clslogdiag.TrayIcon.Log)
            logDiag.WriteLog("Starting diagnostic run")
            m_hwinfo.Init()
            If Not m_hwinfo.Territory.IsAdmin Then
                If DebugOutput Then WriteDebug("No administrator rights, aborting diagnostics")
                MsgBox("Need full rights to run, administrator account windows xp and 'run as admin' on vista / windows 7.")
                logDiag.CloseLog()
                If My.Computer.FileSystem.FileExists(Application.StartupPath & "\Diagnostics.txt") Then
                    If DebugOutput Then WriteDebug("Deleting Diagnostics.txt")
                    My.Computer.FileSystem.DeleteFile(Application.StartupPath & "\Diagnostics.txt")
                End If
                m_hwinfo.Close()
                Exit Try
            End If
            If m_hwinfo.Territory.IsX64 Then
                logDiag.WriteLog("Os: " & m_hwinfo.Territory.OsName & " (x64)")
            Else
                logDiag.WriteLog("Os: " & m_hwinfo.Territory.OsName & " (x86)")
            End If
            Dim lString As String = Mid(m_hwinfo.ohmInterface.OHMReport, 1, m_hwinfo.ohmInterface.OHMReport.IndexOf("SMBIOS Table"))
            logDiag.WriteLog(lString)
            If Not IsNothing(m_hwinfo.ohmInterface.ADL) Then logDiag.WriteLog(m_hwinfo.ohmInterface.ADL.Report)
            If Not IsNothing(m_hwinfo.ohmInterface.NVAPI) Then logDiag.WriteLog(m_hwinfo.ohmInterface.NVAPI.Report)
            If m_hwinfo.gpuInf.oclPlatform_count > 0 Then logDiag.WriteLog(m_hwinfo.gpuInf.openCLReport)
            If m_hwinfo.gpuInf.calDeviceCount > 0 Then logDiag.WriteLog(m_hwinfo.gpuInf.calReport)
            If m_hwinfo.gpuInf.CudaDeviceCount > 0 Then logDiag.WriteLog(m_hwinfo.gpuInf.cudaReport)
            logDiag.WriteLog("Reading client configuration: " & ClientConfig.ReadFAHClientConfig(False, True).ToString)
            If Not IsNothing(ClientConfig.Configuration) Then logDiag.WriteLog(ClientConfig.Configuration.Report(rVal = vbYes))
            logDiag.WriteLog("Running -lspci: " & lsPCI.FillInfo().ToString)
            logDiag.WriteLog(lsPCI.Report)
            clsClientInfo.FAHClientInfo.Parse()
            logDiag.WriteLog("Client info:")
            logDiag.WriteLog(ClientInfo.Info.Report)
            logDiag.WriteLog("Query event log.. ")
            If eLog.QueryEventLog Then
                logDiag.WriteLog(eLog.Report)
            Else
                logDiag.WriteLog("Failed to find any warning or error entries.")
            End If
            logDiag.WriteLog("Closing diagnostics")
            m_hwinfo.ohmInterface.Close()
            Dim mRes As MsgBoxResult = MsgBox("Do you want the report placed on the clipboard? It will always be saved to " & Application.StartupPath & "\Diagnostics.txt as well.", CType(MsgBoxStyle.YesNo + MsgBoxStyle.Question, MsgBoxStyle), "Diagnostics finished")
            If mRes = vbYes Then Clipboard.SetText("[code]" & logDiag.Form.Log & "[/code]")
            logDiag.CloseLog()
        Catch ex As Exception
            MsgBox(Err.Source & "-" & Err.Erl & ":" & Err.Description & Environment.NewLine & Err.GetException.StackTrace.ToString)
        End Try
        Splash.Close()
    End Sub
    Public Sub WhiteList()
        If DebugOutput Then WriteDebug("Whitelist started")
        Splash.Show()
        Splash.ApplicationTitle.Text &= Environment.NewLine & "Whitelist"
        Try
            Dim wlLog As New clsLogwindow
            wlLog.CreateLog("WhitelistMyGPU")
            Dim lsPCI As New clsPci
            If lsPCI.FillInfo Then
                If DebugOutput Then WriteDebug("lsPCI filled info")
                wlLog.WriteLog("Running --lspci: true")
                wlLog.WriteLog(lsPCI.Report)
                Dim rVal As MsgBoxResult = MsgBox("Do you want to place the report on the clipboard?" & Environment.NewLine & Environment.NewLine & "The report will always be saved to " & My.Application.Info.DirectoryPath & "\WhitelistMyGPU.txt.", CType(MsgBoxStyle.Question + MsgBoxStyle.OkCancel, MsgBoxStyle), Application.ProductName & " " & Application.ProductVersion.ToString)
                If rVal = vbOK Then
                    Dim cbT As New StringBuilder
                    cbT.AppendLine("[code]")
                    cbT.Append(wlLog.Form.Log & "[/code]")
                    Clipboard.SetText(cbT.ToString)
                    cbT = Nothing
                    'I removed the browser part as people who need to run this probably already have a tab open.
                    'Process.Start("http://foldingforum.org/viewforum.php?f=67")
                End If
            Else
                If DebugOutput Then WriteDebug("lsPCI failed to fill info")
                MsgBox("Failed to generate a whitelist report", CType(vbOKOnly + vbCritical, MsgBoxStyle))
            End If
        Catch ex As Exception
            MsgBox(Err.Source & "-" & Err.Erl & ":" & Err.Description & Environment.NewLine & Err.GetException.StackTrace.ToString)
        End Try
        If DebugOutput Then WriteDebug("Whitelist closing")
        Splash.Close()
    End Sub


    Public Sub WriteLog(message As String, Optional severity As eSeverity = eSeverity.Informative)
        logwindow.WriteLog(message, severity)
    End Sub
    Public Sub WriteDebug(message As String)
        logwindow.WriteLog(message, eSeverity.Debug)
    End Sub
    Public Sub WriteError(message As String, err As ErrObject)
        logwindow.WriteError(message, err)
    End Sub

    Public Function AccreditWorkunit(WU As clsWU) As clsWU
        Dim rWU As clsWU = WU
        Try
            'Check credit rating
            If WU.Credit = "" Then
                If DebugOutput Then WriteDebug("Starting wu credit check for " & WU.PRCG & " - " & WU.unit)
                If ProjectInfo.Projects.KnownProject(WU.PRCG.Substring(Len("project:"), WU.PRCG.IndexOf(" ") - Len("project:"))) And WU.CoreStatus.Contains("FINISHED_UNIT") And WU.ServerResponce.Contains("WORK_ACK") And Not WU.dtDownloaded = #1/1/2000# And Not WU.dtSubmitted = #1/1/2000# Then
                    'Only calculate if finished_unit and work_ack
                    Dim sPPD As clsProjectInfo.sProjectPPD = ProjectInfo.GetEffectivePPD_sqrt(WU.dtDownloaded, WU.dtSubmitted, WU.PRCG.Substring(Len("project:"), WU.PRCG.IndexOf(" ") - Len("project:")))
                    WU.Credit = sPPD.Credit
                    WU.PPD = sPPD.PPD
                    If DebugOutput Then WriteDebug("Work unit credited to " & WU.Credit & " ppd: " & WU.PPD)
                End If
            ElseIf WU.PPD = "" And ProjectInfo.Projects.KnownProject(WU.PRCG.Substring(Len("project:"), WU.PRCG.IndexOf(" ") - Len("project:"))) And WU.ServerResponce.Contains("WORK_ACK") And WU.Credit <> "" Then
                'If credit was given for partial results this will calculate PPD as well
                If DebugOutput Then WriteDebug("Starting work unit projectinfo ppd check for " & WU.PRCG & " - " & WU.unit)
                WU.PPD = ProjectInfo.GetEffectivePPD_sqrt(WU.dtDownloaded, WU.dtSubmitted, WU.PRCG.Substring(Len("project:"), WU.PRCG.IndexOf(" ") - Len("project:"))).PPD
                If DebugOutput Then WriteDebug("Work unit ppd set to " & WU.PPD)
            ElseIf WU.PPD = "" And WU.Credit <> "" Then
                If DebugOutput Then WriteDebug("Work unit " & WU.PRCG & " - " & WU.unit & " has server assigned credit, calculating ppd by processing time")
                'Calculate ppd from processing time in a day
                Dim rv As New clsProjectInfo.sProjectPPD
                Dim pCompletionTime As TimeSpan = WU.dtSubmitted.Subtract(WU.dtDownloaded)
                rv.Credit = WU.Credit
                'How many frames per 24/h
                Dim iPPD As Double = 0
                Dim tsDay As TimeSpan = TimeSpan.FromDays(1)
                Do
                    If tsDay.Subtract(pCompletionTime).TotalSeconds >= 0 Then
                        iPPD += CInt(rv.Credit)
                        tsDay = tsDay.Subtract(pCompletionTime)
                    Else
                        Exit Do
                    End If
                Loop
                'get fraction of _tsFrame to be done in remaining seconds
                Dim iRfraction As Double
                If tsDay.TotalSeconds > 0 Then
                    iRfraction = tsDay.TotalSeconds / pCompletionTime.TotalSeconds
                    iPPD += iRfraction * CInt(rv.Credit)
                End If
                rv.PPD = CStr(Math.Round(iPPD, 2))
                WU.PPD = rv.PPD
                pCompletionTime = Nothing
                rv = Nothing
                iPPD = Nothing
                tsDay = Nothing
                If DebugOutput Then WriteDebug("Work unit ppd set to " & WU.PPD)
            End If
        Catch ex As Exception
            WriteError(ex.Message, Err)
        End Try
        Return WU
    End Function
    Public ReadOnly Property FormatTimeSpan(TS As TimeSpan) As String
        'Wouldn't need this with .net 4
        Get
            Dim strAvg As String = String.Empty
            If DebugOutput Then WriteDebug("Starting timespan formatting for " & TS.ToString)
            Try
                Return String.Format("{0} Days, {1} hours, {2} minutes and {3} seconds", {TS.Days, TS.Hours, TS.Minutes, TS.Seconds})
            Catch ex As Exception
                WriteError(ex.Message, Err)
                strAvg = "ERROR"
            End Try
            Return strAvg
        End Get
    End Property
    Public ReadOnly Property FormatSQLString(SQL As String, Optional ReturnString As Boolean = False, Optional ContainsTablename As Boolean = False) As String
        Get
            'Check
            If DebugOutput Then WriteDebug("Formatting string for sql, '" & SQL & "' with options ReturnString=" & ReturnString.ToString & " TableName=" & ContainsTablename.ToString)
            Dim rVal As String = SQL
            Try
                'chr(34) & chr(37) & chr(39) & chr(42)
                If ReturnString Then
                    rVal = rVal.Replace(Chr(255), Chr(34))
                    rVal = rVal.Replace(Chr(254), Chr(37))
                    rVal = rVal.Replace(Chr(253), Chr(39))
                    rVal = rVal.Replace(Chr(252), Chr(42))
                Else
                    rVal = rVal.Replace(Chr(34), Chr(255))
                    rVal = rVal.Replace(Chr(37), Chr(254))
                    rVal = rVal.Replace(Chr(39), Chr(253))
                    rVal = rVal.Replace(Chr(42), Chr(252))
                End If
                If ContainsTablename AndAlso ReturnString Then
                    rVal = rVal.Replace("_", "-").Replace(Chr(250), "")
                ElseIf ContainsTablename And Not ReturnString Then
                    rVal = rVal.Replace("-", "_").Replace(" ", Chr(250))
                End If
                If DebugOutput Then WriteDebug("String formatted to: " & rVal)
            Catch ex As Exception
                WriteError(ex.Message, Err)
            End Try
            Return rVal
        End Get
    End Property
#Region "Share enumeration - http://www.pinvoke.net/default.aspx/netapi32.netshareenum"
    Public ServerShareCollection As ShareCollection
    Public Structure ShareType
        Dim Name As String
        Dim Path As String
        Dim Type As Integer
        Dim Remark As String
    End Structure

    Public Structure ShareCollection
        Dim Shares() As ShareType
        Dim ShareCount As Integer
        Sub Clear()
            Shares = Nothing
        End Sub
        Sub Add(ByVal Name As String, ByVal Path As String, ByVal Type As Integer, ByVal Remark As String)
            WriteDebug("Sharecollection add method called with name=" & Name & " path=" & Path & " Type=" & Type & " Remark=" & Remark)
            Try
                If Shares Is Nothing Then
                    ReDim Shares(0)
                    Shares(0).Name = Name
                    Shares(0).Path = Path
                    Shares(0).Type = Type
                    Shares(0).Remark = Remark
                Else
                    ReDim Preserve Shares(Shares.Length)
                    Shares(Shares.Length - 1).Name = Name
                    Shares(Shares.Length - 1).Path = Path
                    Shares(Shares.Length - 1).Type = Type
                    Shares(Shares.Length - 1).Remark = Remark
                End If
            Catch ex As Exception
                WriteError(ex.Message, Err)
            End Try
            If Type = 0 Then
                WriteDebug("Share added to collection")
                ShareCount = ShareCount + 1
            Else
                WriteDebug("Share is not a valid share")
            End If
        End Sub
    End Structure

    Declare Unicode Function NetShareEnum Lib "netapi32.dll" _
        (ByVal ServerName As StringBuilder, _
        ByVal level As Integer, _
        ByRef BufPtr As IntPtr, _
        ByVal prefmaxbufferlen As Integer, _
        ByRef entriesread As Integer, _
        ByRef totalentries As Integer, _
        ByRef resume_handle As Integer) As Integer

    Declare Unicode Function NetShareGetInfo Lib "netapi32.dll" _
    (ByVal ServerName As String, _
    ByVal ShareName As String, _
    ByVal Level As Integer, _
    ByRef BufPtr As IntPtr) As Integer

    Declare Unicode Function NetApiBufferFree Lib "netapi32.dll" (ByRef buffer As IntPtr) As Long



#Region "Constants"

    Const MAX_PREFERRED_LENGTH As Integer = -1      ' originally 0
    Const ERROR_SUCCESS As Long = 0&        ' No errors encountered.
    Const NERR_Success As Long = 0&
    Const ERROR_ACCESS_DENIED As Long = 5&      ' The user has insufficient privilege for this operation.
    Const ERROR_NOT_ENOUGH_MEMORY As Long = 8&      ' Not enough memory
    Const ERROR_NETWORK_ACCESS_DENIED As Long = 65&     ' Network access is denied.
    Const ERROR_INVALID_PARAMETER As Long = 87&     ' Invalid parameter specified.
    Const ERROR_BAD_NETPATH As Long = 53&       ' The network path was not found.
    Const ERROR_INVALID_NAME As Long = 123&     ' Invalid name
    Const ERROR_INVALID_LEVEL As Long = 124&    ' Invalid level parameter.
    Const ERROR_MORE_DATA As Long = 234&        ' More data available, buffer too small.
    Const NERR_BASE As Long = 2100&
    Const NERR_NetNotStarted As Long = 2102&    ' Device driver not installed.
    Const NERR_RemoteOnly As Long = 2106&       ' This operation can be performed only on a server.
    Const NERR_ServerNotStarted As Long = 2114&     ' Server service not installed.
    Const NERR_BufTooSmall As Long = 2123&      ' Buffer too small for fixed-length data.
    Const NERR_RemoteErr As Long = 2127&        ' Error encountered while remotely.  executing function
    Const NERR_WkstaNotStarted As Long = 2138&      ' The Workstation service is not started.
    Const NERR_BadTransactConfig As Long = 2141&    ' The server is not configured for this transaction;  IPC$ is not shared.
    Const NERR_NetNameNotFound As Long = (NERR_BASE + 210)  ' Sharename not found.
    Const NERR_InvalidComputer As Long = 2351&      ' Invalid computername specified.

#End Region ' "Constants"

#Region "API Calls With Structures"

    <StructLayout(LayoutKind.Sequential)> _
    Structure SHARE_INFO_1
        <MarshalAs(UnmanagedType.LPWStr)> Dim netname As String
        Public ShareType As Integer
        <MarshalAs(UnmanagedType.LPWStr)> Dim Remark As String

    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Structure SHARE_INFO_2
        <MarshalAs(UnmanagedType.LPWStr)> Dim shi2_netname As String
        Dim shi2_type As Integer
        <MarshalAs(UnmanagedType.LPWStr)> Dim shi2_remark As String
        Dim shi2_permissions As Integer
        Dim shi2_max_uses As Integer
        Dim shi2_current_uses As Integer
        <MarshalAs(UnmanagedType.LPWStr)> Dim shi2_path As String
        <MarshalAs(UnmanagedType.LPWStr)> Dim shi2_passwd As String
    End Structure

#End Region ' "API Calls With Structures"

    Public Function GetSharesFromHost(ByVal server As String) As ShareCollection
        WriteDebug("GetSharesFromHost function called for server " & server)
        Dim Shares As New ShareCollection
        Shares.Clear()
        Try
            Dim level As Integer = 2
            Dim svr As New StringBuilder(server)
            Dim entriesRead As Integer, totalEntries As Integer, nRet As Integer, hResume As Integer = 0
            Dim pBuffer As IntPtr = IntPtr.Zero
            Try
                nRet = NetShareEnum(svr, level, pBuffer, -1, entriesRead, totalEntries, _
                 hResume)
                If ERROR_ACCESS_DENIED = nRet Then
                    'Need admin for level 2, drop to level 1
                    WriteDebug("NetshareEnum ACCESS_DENIED, dropping to level 1")
                    level = 1
                    nRet = NetShareEnum(svr, level, pBuffer, -1, entriesRead, totalEntries, _
                     hResume)
                End If

                If 0 = nRet AndAlso entriesRead > 0 Then
                    WriteDebug("Enumerating shared for server")
                    Application.DoEvents()
                    Dim t As Type = CType(IIf((2 = level), GetType(SHARE_INFO_2), GetType(SHARE_INFO_1)), Type)
                    Dim offset As Integer = Marshal.SizeOf(t)
                    Dim i As Integer = 0, lpItem As Integer = pBuffer.ToInt32()
                    While i < entriesRead
                        Application.DoEvents()
                        Dim pItem As New IntPtr(lpItem)
                        If 1 = level Then
                            Dim si As SHARE_INFO_1 = DirectCast(Marshal.PtrToStructure(pItem, t), SHARE_INFO_1)
                            Shares.Add(si.netname, "Access Denied", si.ShareType, si.Remark)
                        Else
                            Dim si As SHARE_INFO_2 = DirectCast(Marshal.PtrToStructure(pItem, t), SHARE_INFO_2)
                            Shares.Add(si.shi2_netname, si.shi2_path, si.shi2_type, si.shi2_remark)
                        End If
                        i += 1
                        lpItem += offset
                    End While
                    WriteDebug("Finished enumerating shares, number of shares in collection is " & Shares.ShareCount)
                End If
            Finally
                ' Clean up buffer allocated by system
                WriteDebug("Cleaning buffer")
                If IntPtr.Zero <> pBuffer Then
                    NetApiBufferFree(pBuffer)
                End If
            End Try
        Catch ex As Exception
            WriteError(ex.Message, Err)
        End Try
        Return Shares
    End Function
#End Region
    Public Sub ExitApplication(Optional ByVal Force As Boolean = False, Optional ByVal Confirm As Boolean = False)
        Try
            WriteDebug("Exit application called at " & DateTime.Now.ToString & " Force=" & Force.ToString & " Confirm=" & Confirm.ToString)
            If Confirm Then
                Dim rVal As MsgBoxResult = MsgBox("Exit application?", CType(MsgBoxStyle.OkCancel + MsgBoxStyle.Question, MsgBoxStyle))
                If rVal = MsgBoxResult.Cancel Then
                    WriteDebug("User canceld exit")
                    Exit Sub
                End If
                WriteDebug("User confirmed exit")
            End If
            If Not IsNothing(Bussy) Then
                Bussy.CloseForm()
            End If
            If Not IsNothing(About) Then
                About.CloseAbout()
            End If
            If Not IsNothing(projectInfo) Then
                projectInfo = Nothing
            End If
            If Not IsNothing(sqdata) AndAlso Not sqdata.dbPool.IsClosed Then
                sqdata.dbPool.close()
            End If
            If Not IsNothing(History) Then
                History.Dispose()
            End If
            If Not IsNothing(logwindow.Form) Then
                logwindow.CloseLog()
            End If
            Application.DoEvents()
            'Dim oForms As FormCollection = Application.OpenForms
            'For xInt As Int32 = 0 To oForms.Count - 1
            '    Try
            '        If Not ReferenceEquals(oForms(xInt), frmLogWindow) AndAlso Not IsNothing(oForms(xInt)) AndAlso Not oForms(xInt).Disposing AndAlso Not oForms(xInt).IsDisposed Then oForms(xInt).Dispose()
            '    Catch ex As Exception

            '    End Try
            'Next
            'Force close in 5 seconds 
            Dim nT As New Threading.Thread(AddressOf ForceClose)
            WriteDebug("Starting close thread")
            nT.Start()
            WriteDebug("Calling application.exit")
            Application.Exit()
        Catch ex As Exception
            WriteError(ex.Message, Err)
        End Try
    End Sub
    Public Sub ForceClose()
        WriteDebug("Force close called at " & DateTime.Now.ToString)
        Dim dtClose As DateTime = DateTime.Now.AddSeconds(5)
        While DateTime.Now < dtClose
            Threading.Thread.Sleep(50)
        End While
        WriteDebug("Forcing close at " & DateTime.Now.ToString)
        End
    End Sub
End Module
